# Author: Mario Huys (mario_huys@hotmail.com)
# Description: Helper class for parsing files. Based on expect.

# Expect parses input, be it a string or a file or any other input you implement, searching
# for patterns and executing actions upon a match. 
#
# Input comes in the form of an iexpect::Input object, of which iexpect::StringInput and
# iexpect::FileInput are implemented in this file. See the Input class for more info.
#
# Basic flow:
#  iexpect::Expect I -file "some_file_spec"  # Append other options as fit your purpose.
#  I expect fill "some_reg_exp" {
#    some_action [I get match]
#  } -nocase "other_reg_exp" {
#    other_action [I get output]
#    I continue
#  } eof
#  ...
#  itcl::delete object I
#
# In this and further examples, I chose to call the expect object <I> (or sometimes <you>),
# though any name will do, even <#auto>.
#
# The first line creates the expect object which will handle all the parsing. It's given a
# file spec which it uses to create a iexpect::FileInput object. This object will open the
# file for reading, read data inside as requested by the expect object, and close the file
# when finished. Other forms of input are <-string "some_string"> to parse string data (creates
# a iexpect::StringInput object internally) and <-input "some_input_object">, which can be 
# used to add an object of your own newly created input class, or an input object acquired from
# another expect object (see further).
#
# The second line parses the input for one or more regular expressions, executing an associated
# action in case of a match. Individual expressions can have options associated with them, which
# will alter how the expression is treated. Special patterns like eof can be used to trigger
# special conditions. The last expression of the series may omit the action part. Within actions
# the matching string, parts of it or the unmatched part can be extracted and acted upon. The
# <I continue> statement allows to continue with the same set of patterns and actions after a
# first match was detected, and is more economic than putting the <expect> command inside a loop.
#
# When all information has been extracted which was looked for, the proper procedure is then to
# delete the object and thus free up resources.
#
# Let's take a more detailed look, starting with the creation command.
#
# Apart from input, other options available at creation time are:
#  -re or -ex: Interpret patterns as regular expressions or as exact matches. Glob-style pattern
#    matching is as yet not implemented. Default: -re.
#  -case or -nocase: Makes the parser case (in)sensitive. Default: -case.
#  -white or -nowhite: Treats all whitespace essentially as a single space. Default: -nowhite.
#  -transfer or -notransfer: Orders to discard matching data after a match is made for subsequent
#    matches. This is the usual style of operation. -notransfer is sometimes useful to match the
#    same data several times, perhaps using different expressions. Default: -transfer.
#  -control or -nocontrol: Controls whether input objects will be destroyed at the same time as
#    the expect object is destroyed. In case of -nocontrol, the input object may survive the
#    expect object. This only applies to input objects which are entered using -input or which
#    are being sollicited using the <get input> command. Unsollicited input objects created 
#    internally (through -file or -string) are always destroyed by the expect object. (See also 
#    further). Default: -nocontrol.
#  -buffersize: Sets the buffersize used for matching. Matching strings up to this size are 
#    guaranteed to be matched correctly (provided that no other match gets in the way), longer
#    strings up to double this size may occasionally be found (but don't count on it). (See also
#    the <full_buffer> special pattern). Default: 2048.
#  -nr_match: Sets the maximum number of subportions extracted from a match in a regular expression,
#    each enclosed by <()>. (See the documentation on Tcl's regexp). Default: 9.
#
# Example:
#  iexpect::Expect I -string "Expect  the \n	unexpected." -white
# 
# All these options can be changed during the lifetime of the expect object using the set command, in
# which case the initial <-> is dropped. You may change more than one option in the same command, but
# in that case the latter options must again be preceded by a <->. Note that the input object can be 
# changed just as easily. You can also create an expect object without giving it an input, setting it
# later through <set>. There can however only be one input object active at any time, a previous input
# object will be destroyed (if it's an internal, unsollicited object), stored away for destruction at
# the end of the lifecycle (if it's controlled by this expect object) or simply forgotten.
#
# Example:
#  I set file "different_file_spec" -nocase
# changes the input to start reading from this file, ignoring case.
#
# Some of these option settings can be retrieved using the <is> (for boolean settings) and <get>
# commands.
#
# In case of <is>, which simply returns 0 or 1, the possible options are:
#  re or ex
#  case or nocase
#  white or nowhite
#  transfer or notransfer
#  control or nocontrol
#
# Note that except for <(no)control>, all these options can also be passed on to an individual pattern,
# here they serve only as global settings.
#
# Example:
#  I is white   # returns 1 if whitespace is ignored, 0 otherwise
#  I is nocase  # returns 1 if case insensitive, 0 otherwise
#
# In case of "get", the options are:
#  input
#  buffersize
#  nr_match
# and a number of options specifically related to the matching process (see further).
#
# We'll now turn to the heart of the matter, the <expect> command and its line-oriented counterpart
# <expectLine>. Both are very much lookalike, but where <expect> reads across line boundaries, 
# reading chunks as big as twice the buffersize and discarding only the part that matched the pattern
# before continuing with a new search, <expectLine> reads line by line, has no buffersize upper
# limit, strips off newline characters before matching and discards the whole line after each match.
# A further difference is that <expect> recognizes the <full_buffer> special pattern, while
# <expectline> has a <default> special pattern. Both can be used interchangeably.

# EDIT: Further explanation needed.

# Note: The addition of the input and control options makes it possible to pass on to or share 
# input objects with other Expect objects. Control controls which object is in charge of
# destroying the input object. After turning on control for the object through a <set control>
# command, each <set input "some_input_object"> and <get input> will result in the input object
# being added to the control list of that expect object, which will destroy these objects in its
# destructor method. Conversely, after a <set nocontrol> (which is the initial setting), each 
# <set input "some_input_object"> and <get input> command will take away control over the input 
# object in question. 
# E.g. to share the current input from expect object <I> to expect object <you> without changing
# the controller (which remains <I>), you can use the following code:
#  I set control
#  you set input [I get input]
# To pass on the input object from <I> to <you> and then let <I> go on with some other file, do
#  I set nocontrol  # Is the initial value, can be omitted if control hasn't been changed yet.
#  you set control
#  you set input [I get input]
#  I set file "different_file_spec"
# The central part can be compacted to
#  you set control -input [I get input]
# but !not! to
#  you set input [I get input] -control
# as options are executed from left to right, and thus control in the latter statement wouldn't be
# given until after the <you> object acquired the input object.

package require Itcl
package require Iarray

namespace eval iexpect {

namespace export Expect StringInput FileInput

itcl::class Expect {
	constructor {args} {
		::set iExpectedArray [iarray::Array #auto]
		::set iActionArray [iarray::Array #auto]
		::set iMatchList {}
		for {::set idx 0} {$idx <= 9} {incr idx} {
			::set iMatchArray($idx) ""
			lappend iMatchList iMatchArray($idx)
		}
		alter $args
	}

	destructor {
		if $iInputUnexposed {itcl::delete object $iInput}
		foreach object $iControlledList {itcl::delete object $object}
		itcl::delete object $iExpectedArray
		itcl::delete object $iActionArray
	}

	# Match patterns and actions are analyzed and then passed on as parameters to the process 
	# procedure, instead of stored in instance variables, so that expect calls can be nested. 
	# Expect calls are thus partially reentrant.
	method expect {kind args} {
		# For some people it's easier to write
		#   I expect before {}
		# than
		#   I expect before
		# though both have the same meaning, i.e. to remove the before action.
		# Therefore we make sure we treat it the same.
		if {([llength $args] == 1) && ![string length [lindex $args 0]]} {::set args {}}
		switch $kind "fill" {
			::set result [processFill #[expr [info level] - 1] [::set actionArray [analyze $args 1]]]
			itcl::delete object $actionArray
			return $result
		} "raw" {
			::set result [processFill #[expr [info level] - 1] [::set actionArray [analyze $args 1]]]
			itcl::delete object $actionArray
			return $result
		} "line" {
			::set result [processLine #[expr [info level] - 1] [::set actionArray [analyze $args 1]]]
			itcl::delete object $actionArray
			return $result
		} "before" {
			if {![llength $args]} {
				$iActionArray unset before
			} else {
				$iActionArray acquire before [iarray::code [analyze $args 0]]
			}
		} "after" {
			if {![llength $args]} {
				$iActionArray unset after
			} else {
				$iActionArray acquire after [iarray::code [analyze $args 0]]
			}
		} default {
			error "Recognized expect keywords: \"fill\" (or \"raw\"), \"line\", \"before\" and \"after\". Not \"$kind\""
		}
	}
	method will {id args} {
		if {![llength $args] || [string equal [lindex $args 0] {}]} {
			# Removing actions associated with this id.
			$iExpectedArray rename $id {}
			return {}
		}
		if {[string equal $id "expect"]} {
			# Assigning new id.
			for {::set idx 0} {[$iExpectedArray has "xp$idx"]} {incr idx} {}
			::set id "xp$idx"
		}
		$iExpectedArray acquire $id [iarray::code [analyze $args 0]]
		return $id
	}
	method continue {} {
		::set iReturn 0
		# Force the calling procedure to return immediately, simulating a normal continue.
		return -code return
	}
	method break {} {
		::set iReturn 1
		# Force the calling procedure to return immediately, simulating a normal break.
		return -code return
	}
	method get {var args}
	method is {var}
	method set {var args} {
		# Note that with this implementation it is possible to change more than one option in one command.
		# Simply add extra options preceded by "-", e.g.
		#   I set string "expect" -buffersize 1 -white
		alter [eval list "-$var" $args] 
	}

	protected method alter {optionList}
	protected method alterInput {newInput {exposed 0}}
	protected method addControl {object}
	protected method removeControl {object}
	protected method analyze {wordList preactioned}
	protected method incrLineNr {{buffer "\r\n"}}
	protected method processFill {actionLevel actionArray}
	protected method processLine {actionLevel actionArray}
			
	protected variable iInput {}
	protected variable iInputUnexposed 0
	protected variable iControlledList {}
	protected variable iExpectedArray
	protected variable iActionArray
	protected variable iBufferSize 2048
	protected variable iMatchList
	protected variable iMatchArray
	protected variable iUnmatchedBuffer {}
	protected variable iUncheckedBuffer {}
	protected variable iReturn
	protected variable iPatternMatcher iexpect::RegExpPatternMatch
	protected variable iCase 1
	protected variable iWhite 0
	protected variable iTransfer 1
	protected variable iControl 1
	protected variable iEncoding {}
	protected variable iLineNr 0
	protected variable iLastChar "\n"
}

itcl::body Expect::get {var args} {
	switch -- $var "output" {
		return "$iUnmatchedBuffer$iMatchArray(0)$iUncheckedBuffer"
	} "match" {
		if {[llength $args] == 0} {
			return $iMatchArray(0)
		} else {
			return $iMatchArray([lindex $args 0])
		}
	} "unmatched" {
		return $iUnmatchedBuffer
	} "unchecked" {
		return $iUncheckedBuffer
	} "nr_match" {
		return [expr [llength $iMatchList] - 1]
	} "nr_line" {
		return $iLineNr
	} "line_nr" {
		return $iLineNr
	} "buffersize" {
		return $iBufferSize
	} "input" {
		if $iInputUnexposed {
			::set iInputUnexposed 0
			set iInput [iarray::code $iInput]
			if $iControl {addControl $iInput}
		} else {
			if $iControl {addControl $iInput} else {removeControl $iInput}
		}
		return $iInput
	} default {
		error "Didn't expect to get $var"
	}
}

itcl::body Expect::is {var} {
	switch -- $var "re" {
		string equal $iPatternMatcher iexpect::RegExpPatternMatch
	} "ex" {
		string equal $iPatternMatcher iexpect::ExactPatternMatch
	} "case" {
		expr $iCase
	} "nocase" {
		expr !$iCase
	} "white" {
		expr $iWhite
	} "nowhite" {
		expr !$iWhite
	} "transfer" {
		expr $iTransfer
	} "notransfer" {
		expr !$iTransfer
	} "control" {
		expr $iControl
	} "nocontrol" {
		expr !$iControl
	} default {
		error "Didn't expect to report on $var"
	}
}

itcl::body Expect::alter {optionList} {

	proc setParam {} {
		uplevel {
			if {![llength $optionList]} {error "Option \"$option\" requires parameter."}
			::set param [lindex $optionList 0]; ::set optionList [lrange $optionList 1 end]
			return $param
		}
	}

	if {![llength $optionList]} return

	::set option [lindex $optionList 0]; ::set optionList [lrange $optionList 1 end]
	if {![string equal -length 1 $option "-"]} {error "Option \"$option\" must be preceded by \"-\"."}
	switch -- $option "-string" {
		alterInput [iexpect::StringInput #auto [setParam]]
	} "-file" {
		alterInput [iexpect::FileInput #auto [setParam]]
	} "-input" {
		alterInput [setParam] 1
	} "-re" {
		::set iPatternMatcher iexpect::RegExpPatternMatch
	} "-ex" {
		::set iPatternMatcher iexpect::ExactPatternMatch
	} "-case" {
		::set iCase 1
	} "-nocase" {
		::set iCase 0
	} "-white" {
		::set iWhite 1
	} "-nowhite" {
		::set iWhite 0
	} "-transfer" {
		::set iTransfer 1
	} "-notransfer" {
		::set iTransfer 0
	} "-control" {
		::set iControl 1
	} "-nocontrol" {
		::set iControl 0
	} "-buffersize" {
		::set iBufferSize [setParam]
	} "-nr_match" {
		::set nrOfMatches [setParam]
		::set current [expr [llength $iMatchList] - 1]
		if {$nrOfMatches < $current} {
			for {::set idx [expr $nrOfMatches + 1]} {$idx <= $current} {incr idx} {unset iMatchArray($idx)}
			::set iMatchList [lrange $iMatchList 0 $nrOfMatches]
		} else {
			for {::set idx [expr $current + 1]} {$idx <= $nrOfMatches} {incr idx} {
				::set iMatchArray($idx) ""
				lappend iMatchList iMatchArray($idx)
			}
		}
	} "-encoding" {
		::set iEncoding [setParam]
		if {[string length $iInput]} {
			$iInput set encoding $iEncoding
		}
	} default {
		error "Option \"$option\" unknown."
	}
	
	# This is a recursive method in order to facilitate adding options or treating options differently in subclasses.
	alter $optionList
}

itcl::body Expect::alterInput {newInput {exposed 0}} {
	if {![string length $newInput]} {
		# Get rid of previous input
		if $iInputUnexposed {itcl::delete object $iInput}
		::set iInput {}
		::set iInputUnexposed 0		
	} else {
		if $exposed {
			if {![string length $iInput]} {
				::set iInput $newInput
			} elseif {![$iInput equals $newInput]} {
				# Get rid of previous input
				if $iInputUnexposed {itcl::delete object $iInput}
				::set iInput $newInput
			}
			::set iInputUnexposed 0
			if $iControl {addControl $iInput} else {removeControl $iInput}
		} else {
			# Get rid of previous input
			if $iInputUnexposed {itcl::delete object $iInput}
			::set iInput $newInput
			::set iInputUnexposed 1
		}
		$iInput set encoding $iEncoding
	}
}

itcl::body Expect::addControl {newObject} {
	foreach object $iControlledList {
		if [$newObject equals [iarray::code $object]] return
	}
	lappend iControlledList $newObject
}

itcl::body Expect::removeControl {newObject} {
	::set idx 0
	foreach object $iControlledList {
		if [$newObject equals [iarray::code $object]] {
			::set iControlledList [lreplace $iControlledList $idx $idx]
			return
		}
		incr idx
	}
}

itcl::body Expect::analyze {wordList preactioned} {
	# Translate the arguments to expect.

	proc expand {expected} {
		uplevel eval lappend participantList [$expected of participantList]
		::set actionArray [uplevel ::set actionArray]
		foreach match [$expected of participantList] {
			uplevel $actionArray acquire [uplevel ::set idx] $match
			uplevel incr idx
		}
		if {[$expected has atEnd] && ![$actionArray has atEnd]} {$actionArray acquire [list atEnd [$expected of atEnd]]}
		if {[$expected has atFill] && ![$actionArray has atFill]} {$actionArray acquire [list atFill [$expected of atFill]]}
		if {[$expected has default] && ![$actionArray has default]} {$actionArray acquire [list default [$expected of default]]}
	}

	proc reinit {} {
		uplevel {
			::set matcher $iPatternMatcher
			::set case $iCase
			::set white $iWhite
			::set transfer $iTransfer
			::set selector 0
		}
	}

	proc apply {} {
		uplevel {
			::set match [iarray::code [$matcher #auto $pattern $case $white $word $transfer]]
			$actionArray acquire $idx $match
			incr idx
			lappend participantList $match
		}
	}

	proc specialize {} {
		uplevel {
			if {![$actionArray has $key]} {
				$actionArray acquire $key [iarray::code [iexpect::Match #auto $word $transfer]]
			}
		}
	}

	proc add {} {
		uplevel {
			if {![$iExpectedArray has $word]} {
				error "Value of xp is not a valid expected id."
			}
			expand [$iExpectedArray of $word]
		}
	}

	::set actionArray [iarray::Array #auto]
	::set participantList {}
	::set idx 0

	if {$preactioned && [$iActionArray has before]} {
		expand [$iActionArray of before]
	}

	reinit
	foreach word $wordList {
		switch $selector 0 {
			switch -- $word  "-case" {
				::set case 1
			} "-nocase" {
				::set case 0
			} "-transfer" {
				::set transfer 1
			} "-notransfer" {
				::set transfer 0
			} "-white" {
				# Recognizes a space character in a pattern as representing all kinds of whitespace.
				# Only feasible in a regexp pattern.
				# Can be set globally with the "set white" and "set nowhite" directives
				::set white 1
			} "-nowhite" {
				::set white 0
			} "-ex" {
				::set matcher iexpect::ExactPatternMatch
				::set selector 1
			} "-re" {
				::set matcher iexpect::RegExpPatternMatch
				::set selector 1
			} "-xp" {
				::set selector 4
			} "-before" {
				if [$iActionArray has before] {expand [$iActionArray of before]}
			} "-after" {
				if [$iActionArray has after] {expand [$iActionArray of after]}
			} "eof" {
				::set key atEnd
				::set selector 3
			} "full_buffer" {
				::set key atFill
				::set selector 3
			} "default" {
				::set key default
				::set selector 3
			} default {
				::set pattern $word
				::set selector 2
			}
		} 1 {
			::set pattern $word
			::set selector 2
		} 2 {
			apply
			reinit
		} 3 {
			specialize
			reinit
		} 4 {
			add
			::set selector 0
		}
	}
	switch $selector 2 {
		::set word {}
		apply
	} 3 {
		::set word {}
		specialize
	}		

	if {$preactioned && [$iActionArray has after]} {
		expand [$iActionArray of after]
	}

	$actionArray set participantList $participantList

	return $actionArray
}

itcl::body Expect::incrLineNr {{buffer "\r\n"}} {
	if {![string length $buffer]} {return $iLineNr}
	switch -- $iLastChar "\n" {
		incr iLineNr
	} "\r" {
		if {[string index $buffer 0] == "\n"} {
			if {[string length $buffer] == 1} {
				::set iLastChar '\n'
				return $iLineNr
			}
			set buffer [string range $buffer 1 end]
		}
		incr iLineNr
	}
	::set iLastChar [string index $buffer end]
	incr iLineNr [regexp -all "\r\n|\r|\n" $buffer]
	if {[string first $iLastChar "\r\n"] >= 0} {incr iLineNr -1}
	return $iLineNr
}

itcl::body Expect::processFill {actionLevel actionArray} {
	# When matching fails, the matching info will retain the information of the last match.
	# E.g. to get the last line of a file, you could use this code:
	#   I expect "\[^\n\r\]*" {I continue}
	#   I get match
	# This code will iterate over all lines until it reaches the eof, after which it returns 0.
	# It then fetches the line from the last successful match.
	::set participantList [$actionArray of participantList]
	::set unmatchedBuffer {}
	while {1} {
		if {![string length $iInput]} {return 0}
		# Note: Even the empty input can have a matching pattern
		::set inputBuffer [$iInput read [expr 2 * $iBufferSize]]
		::set atEnd [$iInput atEnd]

		# Search for the pattern with the earliest match in the current buffer.
		::set foundMatch 0
		foreach participant $participantList {
			if [$participant find $inputBuffer] {
				::set match [$participant indices]
				if {!$atEnd && ([lindex $match 0] >= $iBufferSize)} ::continue
				if {!$foundMatch} {
					::set foundMatch 1
					::set bestParticipant $participant
					::set bestMatch $match
				} elseif {[lindex $match 0] < [lindex $bestMatch 0]} {
					::set bestParticipant $participant
					::set bestMatch $match
				}
			}
		}

		if {!$foundMatch} {
			if $atEnd ::break

			# Buffer full
			append unmatchedBuffer [string range $inputBuffer 0 [expr $iBufferSize - 1]]
			$iInput consume $iBufferSize
			if {![$actionArray has atFill]} ::continue
			::set iMatchArray(0) {}
			::set iUnmatchedBuffer $unmatchedBuffer
			::set iUncheckedBuffer {}
			incrLineNr $iUnmatchedBuffer
			::set iReturn 1; [$actionArray of atFill] act $actionLevel; if {$iReturn} {return 1}
			::set unmatchedBuffer {}
			::continue
		}

		# Match found! Get ready to process the action.
		eval [list $bestParticipant extract] $iMatchList
		if {[lindex $bestMatch 0] > 0} {
			append unmatchedBuffer [string range $inputBuffer 0 [expr [lindex $bestMatch 0] - 1]]
		}
		if [$bestParticipant transfer] {
			$iInput consume [expr [lindex $bestMatch 1] + 1]
		} else {
			$iInput consume [lindex $bestMatch 0]
		}
		# Process the action. This may or may not order to continue this expect loop.
		::set iUnmatchedBuffer $unmatchedBuffer
		::set iUncheckedBuffer {}
		incrLineNr $iUnmatchedBuffer; incrLineNr $iMatchArray(0)
		::set iReturn 1; $bestParticipant act $actionLevel; if {$iReturn} {return 1}
		::set unmatchedBuffer {}
	}

	# Reached the end of the input.
	if {![$actionArray has atEnd]} {return 0}
	::set iMatchArray(0) {}
	::set iUnmatchedBuffer [append unmatchedBuffer $inputBuffer]
	::set iUncheckedBuffer {}
	incrLineNr $iUnmatchedBuffer
	[$actionArray of atEnd] act $actionLevel
	return 1
}

itcl::body Expect::processLine {actionLevel actionArray} {
	# When matching fails, the matching info will retain the information of the last match.
	# E.g. to get the last line of a file, you could use this code:
	#   I expect line default {I continue}
	#   I get match
	# This code will iterate over all lines until it reaches the eof, after which it returns 0.
	# It then fetches the line from the last successful match.
	::set participantList [$actionArray of participantList]
	while {1} {
		if {![string length $iInput]} {return 0}
		# Read one line from the input buffer
		if [$iInput atEnd] ::break
		::set lineBuffer [$iInput readLine]
		incrLineNr

		# Search for the first pattern that matches the current line.
		::set foundMatch 0
		foreach participant $participantList {
			if [$participant find $lineBuffer] {
				::set match [$participant indices]
				# Break at the earliest opportunity
				#if {!$foundMatch} {
					::set foundMatch 1
					::set bestParticipant $participant
					::set bestMatch $match
					::break
				#} elseif {[lindex $match 0] < [lindex $bestMatch 0]} {
				#	::set bestParticipant $participant
				#	::set bestMatch $match
				#}
			}
		}

		if {!$foundMatch} {
			::set iMatchArray(0) {}
			::set iUnmatchedBuffer $lineBuffer
			::set iUncheckedBuffer {}
			if {![$actionArray has default]} {return 1}
			::set iReturn 1; [$actionArray of default] act $actionLevel; if {$iReturn} {return 1}
			::continue
		}

		# Match found! Get ready to process the action.
		eval [list $bestParticipant extract] $iMatchList
		if {[lindex $bestMatch 0] == 0} {
			::set iUnmatchedBuffer {}
		} else {
			::set iUnmatchedBuffer [string range $lineBuffer 0 [expr [lindex $bestMatch 0] - 1]]
		}
		::set iUncheckedBuffer [string range $lineBuffer [expr [lindex $bestMatch 1] + 1] end]
		if {![$bestParticipant transfer]} {
			$iInput consume [lindex $bestMatch 0]
		}
		# Process the action. This may or may not order to continue this expect loop.
		::set iReturn 1; $bestParticipant act $actionLevel; if {$iReturn} {return 1}
	}

	# Reached the end of the input.
	if {![$actionArray has atEnd]} {return 0}
	::set iMatchArray(0) {}
	::set iUnmatchedBuffer {}
	::set iUncheckedBuffer {}
	[$actionArray of atEnd] act $actionLevel
	return 1
}

itcl::class Input {
	method read {chunkSize} {return ""}
	method readLine {} {return ""}
	method consume {chunkSize} {} 
	method atEnd {} {return 1}
	method equals {object} {
		if {![$object isa [info class]]} {return 0}
		::set _iEqual 1
		::set equal [$object info variable _iEqual -value]
		::set _iEqual 0
		return $equal
	}
	method get {var} {return ""}
	method set {var val} {}

	protected variable _iEqual 0
}

itcl::class StringInput {
	inherit Input

	constructor {str} {::set iString $str}

	method read {chunkSize} {
		if {$chunkSize >= [string length $iString]} {
			::set iRead $iString
			::set iString ""
		} else {
			::set iRead [string range $iString 0 [expr $chunkSize - 1]]
			::set iString [string range $iString $chunkSize end]
		}
		return $iRead
	}
	method readLine {} {
		regexp "(\[^\n\r\]*)\r?\n?" $iString iRead line
		::set iString [string range $iString [string length $iRead] end]
		return $line
	}
	method consume {chunkSize} {
		::set iRead [string range $iRead $chunkSize end]
		::set iString [append iRead $iString]
		::set iRead ""
	}
	method atEnd {} {expr [string length $iString] == 0}

	variable iString
	variable iRead ""
}

itcl::class FileInput {
	inherit Input

	constructor {fileName} {
		::set iFileId [open $fileName r]
		::set iDefaultEncoding [fconfigure $iFileId -encoding]
		::set iEncoding $iDefaultEncoding
	}
	destructor {
		if {!$iClosed} {close $iFileId}
	}

	method read {chunkSize} {
		if {[::set bufferLength [string length $iBuffer]] == 0} {
			::set iRead {}
		} else {
			if {$chunkSize <= $bufferLength} {
				::set iRead [string range $iBuffer 0 [expr $chunkSize - 1]]
				::set iBuffer [string range $iBuffer $chunkSize end]
				return $iRead
			}
			::set iRead $iBuffer
			::set iBuffer {}
			incr chunkSize [expr -$bufferLength]
		}
		if {$iClosed} {
			return $iRead
		}

		append iRead [::read $iFileId $chunkSize]

		if [eof $iFileId] {
			close $iFileId
			::set iClosed 1
		}
		return $iRead
	}
	method readLine {} {
		if {[::set bufferLength [string length $iBuffer]] == 0} {
			::set iRead {}
		} else {
			regexp "(\[^\n\r\]*)(\r?\n?)" $iBuffer iRead line newline
			if {[string length $newline] > 0} {
				::set iBuffer [string range $iBuffer [string length $iRead] end]
				return $line
			}
			::set iBuffer {}
		}
		if {$iClosed} {
			return iRead
		}

		::set line [append iRead [::gets $iFileId]]

		append iRead "\n"
		if [eof $iFileId] {
			close $iFileId
			::set iClosed 1
		}
		return $line
	}
	method consume {chunkSize} {
		::set iRead [string range $iRead $chunkSize end]
		::set iBuffer [append iRead $iBuffer]
		::set iRead {}
	}
	method atEnd {} {expr ([string length $iBuffer] == 0) && $iClosed}
	method get {var} {
		switch $var encoding {
			return $iEncoding
		} default {
			return [chain $var]
		}
	}
	method set {var val} {
		switch $var encoding {
			if {![string length $val]} {
				::set val $iDefaultEncoding
			}
			if {![string equal $val $iEncoding]} {
				fconfigure $iFileId -encoding $val
				::set iEncoding $val
			}
		} default {
			chain $var $val
		}
	}

	variable iFileId
	variable iClosed 0
	variable iRead {}
	variable iBuffer {}
	variable iEncoding {}
	protected variable iDefaultEncoding {}
}

itcl::class Match {
	constructor {{action {}} {transfer 1}} {
		::set iAction $action
		::set iTransfer $transfer
	}

	method act {actionLevel} {uplevel $actionLevel $iAction}
	method transfer {} {return $iTransfer}

	variable iAction
	variable iTransfer
}

itcl::class PatternMatch {
	inherit Match

	constructor {pattern {case 1} {white 0} {action {}} {transfer 1}} {
		iexpect::Match::constructor $action $transfer
	} {
		::set iPattern $pattern
		::set iCase $case
		::set iWhite $white
	}

	method find {data} {::set iIndices {}; return 0}
	method indices {} {return $iIndices}
	method extract {args} {}

	variable iPattern
	variable iCase
	variable iWhite
	variable iIndices
}

itcl::class ExactPatternMatch {
	inherit PatternMatch

	constructor {pattern {case 1} {white 0} {action {}} {transfer 1}} {
		iexpect::PatternMatch::constructor $pattern $case $white $action $transfer
	} {}

	method find {data} {
		::set iMatch {}
		::set iIndices {}
		if {$iCase} {
			::set first [string first $iPattern $data]
			if {$first == -1} {return 0}
			::set last [expr $first + [string length $iPattern] - 1]
			::set iMatch $iPattern
		} else {
			::set first [string first $iPattern [string tolower $data]]
			if {$first == -1} {return 0}
			::set last [expr $first + [string length $iPattern] - 1]
			::set iMatch [string range $data $first $last]
		}
		::set iIndices "$first $last"
		return 1
	}
	method extract {args} {uplevel ::set [lindex $args 0] $iMatch; return}

	variable iMatch {}
}

itcl::class RegExpPatternMatch {
	inherit PatternMatch

	common sWhiteSpace " \t\n\r"

	constructor {pattern {case 1} {white 0} {action {}} {transfer 1}} {
		iexpect::PatternMatch::constructor $pattern $case $white $action $transfer
	} {
		if $iWhite {
			# Append an opening bracket to facilitate the loop and to ensure that there's at least one character
			# behind every character we'd like to replace, so that we can compare if such a character is not
			# followed by another one we'd like to treat differently.
			set pattern "$iPattern\["
			set forming ""
			while 1 {
				set open [string first "\[" $pattern]
				if {$open > 0 && [string length $pattern] > [expr $open + 1] && [string equal "\\" [string index $pattern [expr $open - 1]]]} {
					set escaped 1
					set nonBracket [string range $pattern 0 [expr $open -1]]
				} else {
					set escaped 0
					set nonBracket [string range $pattern 0 $open]
				}
				regsub -all " (\[^ ?*+\{\])" $nonBracket "\[$sWhiteSpace\]+\\1" nonBracket
				regsub -all " \[?*\]" $nonBracket "\[$sWhiteSpace\]*" nonBracket
				regsub -all " (\[+\{\])" $nonBracket "\[$sWhiteSpace\]\\1" nonBracket
				regsub -all "\[\[.^.\]\](\[^$\])" $nonBracket "^\[$sWhiteSpace\]*\\1" nonBracket
				regsub -all "\[$\]" $nonBracket "\[$sWhiteSpace\]*$" nonBracket
				append forming $nonBracket

				if {[string length $pattern] == [expr $open + 1]} break
				set pattern [string range $pattern [expr $open + 1] end]
				if {$escaped} {
					append forming "\["
					continue
				}

				if [string equal -length 1 $pattern "^"] {
					append forming "^"
					set pattern [string range $pattern 1 end]
				}
				if [string equal -length 1 $pattern "\]"] {
					append forming "\]"
					set pattern [string range $pattern 1 end]
				}
				if [string equal -length 1 $pattern "\["] {
					append forming "\["
					set pattern [string range $pattern 1 end]
				}
				if {[set close [string first "\]" $pattern]] == -1} {
					error "No matching closing square bracket in $iPattern"
				}
				append forming [regsub " " [string range $pattern 0 $close] $sWhiteSpace]
				set pattern [string range $pattern [expr $close + 1] end]
			}
			set iPattern [string range $forming 0 end-1]
		}
	}

	method find {data} {
		::set iMatch {}
		::set iIndices {}
		if {$iCase} {
			::set found [regexp -indices -- $iPattern $data iIndices]
		} else {
			::set found [regexp -indices -nocase -- $iPattern $data iIndices]
		}
		if {$found == 0} {return 0}
		::set iMatch [eval [list string range $data] $iIndices]
		return 1
	}
	method extract {args} {
		if {[string compare $iMatch {}] == 0} {return 0}
		if {$iCase} {
			uplevel [list regexp -- $iPattern $iMatch] $args
		} else {
			uplevel [list regexp -nocase -- $iPattern $iMatch] $args
		}
		return
	}

	variable iMatch {}
}

}

package provide Iexpect 1.0

